! xsdplain.f90 --
!     Program to read an XSD file (XML schema) written in a "flat"
!     style - i.e. no nested definitions but references to definitions -
!     and convert it to a description suitable to xmlreader.
!
!     TODO:
!     Determine the root element - this is the topmost element, right
!     now we interpret it as a variable. This is kind of tricky, though.
!
!     TODO:
!     Get rid of the repetition of the select case
!
!     TODO:
!     xs:boolean - can we convert this to logical?
!
!     TODO:
!     Type of attribute can be a simpleType, right now we simply assume
!     a string
!
!     TODO:
!     ComplexType may have attributes too
!
!     TODO:
!     Check why setting strict_ = .true. produces so many warnings
!
program xsdplain
    use xml_data_readxsd
    logical :: all_written
    integer :: i, j, count
    type(xs_component), dimension(:), pointer :: component
    type(xs_element), pointer :: ref_element

    open( 20, file = 'xsdplain.out' )
    call read_xml_file_readxsd( 'cxml.0.2.xml', 20 )

    write( 20, '(a)'  ) '<?xml version="1.0"?>'
    write( 20, '(a)'  ) '<template>'
    write( 20, '(a)'  ) '<!-- Template generated from XSD file -->'
    write( 20, '(3a)' ) '<options rootname="', trim(element(1)%name), '"/>'

    all_written = .false.
    count = 0

    do while ( .not. all_written .and. count < 100 )
        count = count + 1
        all_written = .true.

 loop_elements: &
        do i = 1,size(element)
            if ( .not. element(i)%written ) then
                component => null()
                if ( associated(element(i)%complexType%all%component) ) then
                    component => element(i)%complexType%all%component
                endif
                if ( associated(element(i)%complexType%choice%component) ) then
                    component => element(i)%complexType%choice%component
                endif
                if ( associated(element(i)%complexType%sequence%component) ) then
                    component => element(i)%complexType%sequence%component
                endif

                if ( associated(component) ) then
                    do j = 1,size(component)
                        call find_reference( component(j)%ref, ref_element )
                        if ( .not. associated(ref_element) ) then
                            write(20,*) 'Problem: element referred to that is not defined: ', trim(component(i)%ref)
                        else
                            ref_element%referred = .true.

                            if ( .not. ref_element%written ) then
                                all_written = .false.
                               cycle loop_elements
                            endif
                        endif
                    enddo
                else
                    element(i)%simple = .true.
                    if ( associated( element(i)%complexType%simpleContent%extension%attribute ) ) then
                        !write(20,*) 'Simple content: ', trim(element(i)%name)
                    else
                        !write(20,*) 'Plain: ', trim(element(i)%name)
                    endif
                endif

                element(i)%written = .true.
                !write(20,*) 'Define: ',trim(element(i)%name)
                if ( i > 1 ) then
                    call write_element_definition( element(i) )
                endif
            endif
        enddo loop_elements
    enddo

    !
    ! Write any variables
    !
    do i = 1,size(element)
         if ( .not. element(i)%referred ) then
             call write_variable( element(i) )
         endif
    enddo

    write( 20, '(a)' ) '</template>'
    close( 20 )

contains
subroutine find_reference( name, ref_element )
    character(len=*) :: name
    type(xs_element), pointer :: ref_element

    integer :: k

    ref_element => null()

    do k = 1,size(element)
         if ( element(k)%name == name ) then
             ref_element => element(k)
             exit ! Check for uniqueness?
         endif
    enddo

end subroutine

subroutine write_element_definition( element )
    type(xs_element) :: element

    type(xs_component), dimension(:), pointer :: component
    type(xs_attribute), dimension(:), pointer :: attribute
    type(xs_element), pointer                 :: referred_elem
    character(len=80)                         :: dim

    !
    ! Simple elements are not separate types
    !
    if ( element%simple ) return

    !
    ! Variables are those elements that are not referred to themselves!
    !
    write( 20, '(a)' ) ' '
    write( 20, '(3a)' ) '<typedef name="t_',trim(element%name),'">'

    component => null()
    if ( associated(element%complexType%all%component) ) then
        component => element%complexType%all%component
    endif
    if ( associated(element%complexType%choice%component) ) then
        component => element%complexType%choice%component
    endif
    if ( associated(element%complexType%sequence%component) ) then
        component => element%complexType%sequence%component
    endif

    if ( associated(component) ) then
        do j = 1,size(component)
            call find_reference( component(j)%ref, referred_elem )

            if ( component(j)%minOccurs /= "1" .or. &
                 component(j)%maxOccurs /= "1" ) then
                dim = 'dimension="1" default="=> null()"'  !! INCORRECT!
            else
                dim = ''
            endif

            if ( referred_elem%simple ) then
                select case ( referred_elem%type )
                    case( 'xs:integer', 'xs:nonNegativeInteger' )
                        write( 20, '(3a)' ) &
                            '   <component name="', trim(referred_elem%name), &
                            '" type="integer"/>'
                    case default
                        !
                        ! TODO: boolean
                        !
                        write( 20, '(3a)' ) &
                            '   <component name="', trim(referred_elem%name), &
                            '" type="line" length="40"/>'
                end select
            else
                write( 20, '(5a)' ) &
                    '   <component name="', trim(component(j)%ref), &
                    '" type="t_', trim(component(j)%ref),  '" ' // trim(dim) // '"/>'
            endif
        enddo
    else
        if ( associated( element%complexType%simpleContent%extension%attribute ) ) then
            attribute => element%complexType%simpleContent%extension%attribute

            do j = 1,size(attribute)
                select case ( attribute(j)%type )
                    case( 'xs:integer', 'xs:nonNegativeInteger' )
                        write( 20, '(3a)' ) &
                            '   <component name="', trim(attribute(j)%name), &
                            '" type="integer"/>'
                    case default
                        !
                        ! TODO: boolean
                        !
                        write( 20, '(3a)' ) &
                            '   <component name="', trim(attribute(j)%name), &
                            '" type="line" length="40"/>'
                end select
            enddo
        else
            select case ( element%type )
                case( 'xs:integer', 'xs:nonNegativeInteger' )
                    write( 20, '(3a)' ) &
                        '   <component name="', trim(element%name), &
                        '" type="integer"/>'
                case default
                    !
                    ! TODO: boolean
                    !
                    write( 20, '(3a)' ) &
                        '   <component name="', trim(element%name), &
                        '" type="line" length="40"/>'
            end select
        endif
    endif

    write( 20, '(a)' ) '</typedef>'

end subroutine

!
! Ugly: I had to copy the code from write_element_definition
! and adjust it. This must be parametrised!
!
subroutine write_variable( element )
    type(xs_element) :: element

    type(xs_component), dimension(:), pointer :: component
    type(xs_attribute), dimension(:), pointer :: attribute
    type(xs_element), pointer                 :: referred_elem
    character(len=80)                         :: dim

    !
    ! Simple elements are not separate types
    !
    if ( element%simple ) return

    component => null()
    if ( associated(element%complexType%all%component) ) then
        component => element%complexType%all%component
    endif
    if ( associated(element%complexType%choice%component) ) then
        component => element%complexType%choice%component
    endif
    if ( associated(element%complexType%sequence%component) ) then
        component => element%complexType%sequence%component
    endif

    if ( associated(component) ) then
        do j = 1,size(component)
            call find_reference( component(j)%ref, referred_elem )

            if ( component(j)%minOccurs /= "1" .or. &
                 component(j)%maxOccurs /= "1" ) then
                dim = 'dimension="1" default="=> null()"'  !! INCORRECT!
            else
                dim = ''
            endif

            if ( referred_elem%simple ) then
                select case ( referred_elem%type )
                    case( 'xs:integer', 'xs:nonNegativeInteger' )
                        write( 20, '(3a)' ) &
                            '<variable name="', trim(referred_elem%name), &
                            '" type="integer"/>'
                    case default
                        !
                        ! TODO: boolean
                        !
                        write( 20, '(3a)' ) &
                            '<variable name="', trim(referred_elem%name), &
                            '" type="line" length="40"/>'
                end select
            else
                write( 20, '(5a)' ) &
                    '<variable name="', trim(component(j)%ref), &
                    '" type="t_', trim(component(j)%ref),  '" ' // trim(dim) // '"/>'
            endif
        enddo
    else
        if ( associated( element%complexType%simpleContent%extension%attribute ) ) then
            attribute => element%complexType%simpleContent%extension%attribute

            do j = 1,size(attribute)
                select case ( attribute(j)%type )
                    case( 'xs:integer', 'xs:nonNegativeInteger' )
                        write( 20, '(3a)' ) &
                            '<variable name="', trim(attribute(j)%name), &
                            '" type="integer"/>'
                    case default
                        !
                        ! TODO: boolean
                        !
                        write( 20, '(3a)' ) &
                            '<variable name="', trim(attribute(j)%name), &
                            '" type="line" length="40"/>'
                end select
            enddo
        else
            select case ( element%type )
                case( 'xs:integer', 'xs:nonNegativeInteger' )
                    write( 20, '(3a)' ) &
                        '<variable name="', trim(element%name), &
                        '" type="integer"/>'
                case default
                    !
                    ! TODO: boolean
                    !
                    write( 20, '(3a)' ) &
                        '<variable name="', trim(element%name), &
                        '" type="line" length="40"/>'
            end select
        endif
    endif

end subroutine

end program
